home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 92 / 092.d81 / tile basic (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  9KB  |  230 lines
  1. 100 ifpeek(56)<>144thenpoke56,144:poke46,64:poke45,1:clr
  2. 105 dv=peek(186):ifdv<8thendv=8
  3. 110 ifa=0thena=1:load"toolbox c000",dv,1
  4. 120 ifa=1thena=2:load"tile font",dv,1
  5. 130 ifa=2thena=3:load"redraw.o",dv,1
  6. 140 ifa=3thena=4:load"getword 9000",dv,1
  7. 150 dimdm$(7),gm$(7),tm$(10),c$(16):de=peek(186):ifde<8thende=8
  8. 160 fori=1to7:readdm$(i):next:fori=1to7:readgm$(i):next
  9. 170 fori=1to4:readtm$(i):next:fori=1to16:readc$(i):next
  10. 180 c=15:c2=12:c3=3:c4=14:c5=5:c6=13:c7=7:c8=8:c9=9:ft=14336:bs=40960-720
  11. 190 mt=49152:l=mt:poke53272,31:m=8:poke53281,0:poke53280,0:tc=13:gc=14:cc=1:bc=0
  12. 200 gosub1220
  13. 210 poke646,tc:print" [212][201][204][197][205][197][201][211][212][197][210] by [202]eff [202]ones [221] ^ for [205]enus":sysmt+12
  14. 220 sys51456,m,gc,tc
  15. 230 sysmt+6,208:poke646,cc:sysmt+15,1,1,"@":x=1:y=1:g=1
  16. 240 sysmt+42,"[157][145]m [160]^"+chr$(20)+"123456789[147]fogcbrvsq"
  17. 250 geta$:onval(a$)goto300,280,340,320,540,360,360,1270,560:a=asc(a$)-48
  18. 260 ona-9goto740,750,760,770,780,790,800,810,820,920,990,830,850,870,890,1120
  19. 270 ona-25goto1140,1150,2270
  20. 280 sysmt+9,208:x=x+1:ifx>mthenx=1:y=y+1:ify>mtheny=1
  21. 290 poke646,cc:sysmt+15,x,y,"@":goto240
  22. 300 sysmt+9,208:x=x-1:ifx<1thenx=m:y=y-1:ify<1theny=m
  23. 310 poke646,cc:sysmt+15,x,y,"@":goto240
  24. 320 sysmt+9,208:y=y+1:ify>mtheny=1:x=x+1:ifx>mthenx=1
  25. 330 poke646,cc:sysmt+15,x,y,"@":goto240
  26. 340 sysmt+9,208:y=y-1:ify<1theny=m:x=x-1:ifx<1thenx=m
  27. 350 poke646,cc:sysmt+15,x,y,"@":goto240
  28. 360 poke646,tc:sysmt+15,x,y,"@":sysmt+6,208:onm/8goto370,380,430
  29. 370 pokeft+246*8+y-1,peek(ft+246*8+y-1)or2^(8-x):goto280
  30. 380 ify>8then410
  31. 390 ifx<9thenpokeft+246*8+y-1,peek(ft+246*8+y-1)or2^(8-x):goto280
  32. 400 pokeft+247*8+y-1,peek(ft+247*8+y-1)or2^(16-x):goto280
  33. 410 ifx<9thenpokeft+248*8+y-9,peek(ft+248*8+y-9)or2^(8-x):goto280
  34. 420 pokeft+249*8+y-9,peek(ft+249*8+y-9)or2^(16-x):goto280
  35. 430 ify>8then470
  36. 440 ifx<9thenpokeft+246*8+y-1,peek(ft+246*8+y-1)or2^(8-x):goto280
  37. 450 ifx<17thenpokeft+247*8+y-1,peek(ft+247*8+y-1)or2^(16-x):goto280
  38. 460 pokeft+248*8+y-1,peek(ft+248*8+y-1)or2^(24-x):goto280
  39. 470 ify>16then510
  40. 480 ifx<9thenpokeft+249*8+y-9,peek(ft+249*8+y-9)or2^(8-x):goto280
  41. 490 ifx<17thenpokeft+250*8+y-9,peek(ft+250*8+y-9)or2^(16-x):goto280
  42. 500 pokeft+251*8+y-9,peek(ft+251*8+y-9)or2^(24-x):goto280
  43. 510 ifx<9thenpokeft+252*8+y-17,peek(ft+252*8+y-17)or2^(8-x):goto280
  44. 520 ifx<17thenpokeft+253*8+y-17,peek(ft+253*8+y-17)or2^(16-x):goto280
  45. 530 pokeft+254*8+y-17,peek(ft+254*8+y-17)or2^(24-x):goto280
  46. 540 print"[147]":sysmt+12:m=m+8:ifm>24thenm=8
  47. 550 goto200
  48. 560 poke646,gc:sysmt+15,x,y,"[146]@":sysmt+6,208:onm/8goto570,580,630
  49. 570 pokeft+246*8+y-1,peek(ft+246*8+y-1)and(255-2^(8-x)):goto300
  50. 580 ify>8then610
  51. 590 ifx<9thenpokeft+246*8+y-1,peek(ft+246*8+y-1)and(255-2^(8-x)):goto300
  52. 600 pokeft+247*8+y-1,peek(ft+247*8+y-1)and(255-2^(16-x)):goto300
  53. 610 ifx<9thenpokeft+248*8+y-9,peek(ft+248*8+y-9)and(255-2^(8-x)):goto300
  54. 620 pokeft+249*8+y-9,peek(ft+249*8+y-9)and(255-2^(16-x)):goto300
  55. 630 ify>8then670
  56. 640 ifx<9thenpokeft+246*8+y-1,peek(ft+246*8+y-1)and(255-2^(8-x)):goto300
  57. 650 ifx<17thenpokeft+247*8+y-1,peek(ft+247*8+y-1)and(255-2^(16-x)):goto300
  58. 660 pokeft+248*8+y-1,peek(ft+248*8+y-1)and(255-2^(24-x)):goto300
  59. 670 ify>16then710
  60. 680 ifx<9thenpokeft+249*8+y-9,peek(ft+249*8+y-9)and(255-2^(8-x)):goto300
  61. 690 ifx<17thenpokeft+250*8+y-9,peek(ft+250*8+y-9)and(255-2^(16-x)):goto300
  62. 700 pokeft+251*8+y-9,peek(ft+251*8+y-9)and(255-2^(24-x)):goto300
  63. 710 ifx<9thenpokeft+252*8+y-17,peek(ft+252*8+y-17)and(255-2^(8-x)):goto300
  64. 720 ifx<17thenpokeft+253*8+y-17,peek(ft+253*8+y-17)and(255-2^(16-x)):goto300
  65. 730 pokeft+254*8+y-17,peek(ft+254*8+y-17)and(255-2^(24-x)):goto300
  66. 740 c=(c+1)and15:goto200
  67. 750 c2=(c2+1)and15:goto200
  68. 760 c3=(c3+1)and15:goto200
  69. 770 c4=(c4+1)and15:goto200
  70. 780 c5=(c5+1)and15:goto200
  71. 790 c6=(c6+1)and15:goto200
  72. 800 c7=(c7+1)and15:goto200
  73. 810 c8=(c8+1)and15:goto200
  74. 820 c9=(c9+1)and15:goto200
  75. 830 tc=(tc+1)and15:iftc=(peek(53281)and15)then830
  76. 840 goto220
  77. 850 gc=(gc+1)and15:ifgc=(peek(53281)and15)then850
  78. 860 goto220
  79. 870 cc=(cc+1)and15:ifcc=(peek(53281)and15)then870
  80. 880 poke646,cc:sysmt+15,x,y,"@":goto240
  81. 890 bc=(bc+1)and15:ifbc=tcorbc=gcorbc=ccthen890
  82. 900 poke53281,bc:poke53280,bc:goto240
  83. 910 rem clear grids
  84. 920 ms$="[195]lear [199]rid?  [193]re [217]ou [211]ure? ([217]/[206])":gosub1050:geta$
  85. 930 ifa$<>"y"then240
  86. 940 onm/8goto950,960,970
  87. 950 fori=ft+246*8toft+246*8+7:pokei,0:next:goto220
  88. 960 fori=ft+246*8toft+249*8+7:pokei,0:next:goto220
  89. 970 fori=ft+246*8toft+254*8+7:pokei,0:next:goto220
  90. 980 rem fill grids
  91. 990 ms$="[198]ill [199]rid?  [193]re [217]ou [211]ure? ([217]/[206])":gosub1050:geta$
  92. 1000 ifa$<>"y"then240
  93. 1010 onm/8goto1020,1030,1040
  94. 1020 fori=ft+246*8toft+246*8+7:pokei,255:next:goto220
  95. 1030 fori=ft+246*8toft+249*8+7:pokei,255:next:goto220
  96. 1040 fori=ft+246*8toft+254*8+7:pokei,255:next:goto220
  97. 1050 ifpeek(787)<>255thensysmt+6,216
  98. 1060 sysmt+3,2,38,12,16,255,gc:poke199,1
  99. 1070 sysmt+3,1,37,11,15,160,tc:poke646,tc:sysmt+18,13,ms$
  100. 1080 ifpeek(787)=255thenpoke787,0:return
  101. 1090 poke198,0:wait198,15
  102. 1100 sysmt+9,216:return
  103. 1110 rem reverse
  104. 1120 sys51459,m:goto220
  105. 1130 rem show screen
  106. 1140 sysmt+6,216:gosub1220:poke198,0:wait198,15:geta$:sysmt+9,216:goto240
  107. 1150 sysmt+6,216:sysmt+3,22,33,1,11,160,tc:print"";:poke646,tc
  108. 1160 sysmt+18,24," [208]lease [211]elect [211]torage [211]lot ":poke646,tc
  109. 1170 fori=1to10:sysmt+15,23,i,"[211]lot"+str$(i):next:sysmt+15,23,i,dm$(7)
  110. 1180 sysmt,1,22,33,11,tc,gc,0:sysmt+6,232:sysmt+9,216:geta$
  111. 1182 ifa$=";"thensysmt+9,208:goto240
  112. 1185 a=asc(a$)-48:sb=bs+72*(a-1)
  113. 1190 a=ft+246*8:fori=0to71:aa=peek(sb+i):pokesb+i,peek(a+i):pokea+i,aa:next
  114. 1200 goto200
  115. 1210 rem screen fill
  116. 1220 ifm=8thensysmt+3,0,39,0,24,246,c
  117. 1230 ifm=16thensysmt+36,246,247,248,249,c,c2,c3,c4
  118. 1240 ifm=24thensysl+39,246,247,248,249,250,251,252,253,254,c,c2,c3,c4,c5,c6,c7,c8,c9
  119. 1250 return
  120. 1260 rem menus
  121. 1270 sysmt+6,216:poke646,tc:print" [196]isk   [199]rid   [212]iles  [209]uadrant [195]olors   "
  122. 1280 sysmt+18,24,"  [211][208][193][195][197] [212]o [211]witch [194]etween [205]enus  ":poke646,gc:sysmt+6,224
  123. 1290 mu=1:sysmt+3,1,15,1,9,160,gc:print"";
  124. 1300 fori=1to6:sysmt+15,2,i,dm$(i):next
  125. 1310 sysmt+15,2,i,"[196]evice [206]umber":sysmt+15,2,i+1,dm$(7)
  126. 1320 sysmt+15,2,i+2,"[204][207][193][196][211][212][193][210]"
  127. 1330 sysmt,1,1,15,9,gc,tc,32:sysmt+6,232:sysmt+9,216:geta$:ifval(a$)=0then1350
  128. 1340 onval(a$)goto1680,1780,1900,1960,2020,2080,2100,240,2270
  129. 1350 mu=2:sysmt+9,224:sysmt+3,8,29,1,8,160,gc:print"";:poke646,gc
  130. 1360 fori=1to7:sysmt+15,9,i,gm$(i):next:sysmt+15,9,i,dm$(7)
  131. 1370 sysmt,1,8,29,8,gc,tc,32:sysmt+6,232:sysmt+9,216:geta$:ifval(a$)=0then1460
  132. 1380 onval(a$)goto1390,1400,1410,1420,1430,1440,1450,240
  133. 1390 m=24:goto540
  134. 1400 m=8:goto540
  135. 1410 m=16:goto540
  136. 1420 gosub1640:gc=co:goto220
  137. 1430 gosub1640:tc=co:goto220
  138. 1440 gosub1640:cc=co:goto220
  139. 1450 gosub1640:bc=co:poke53280,bc:poke53281,bc:goto240
  140. 1460 mu=3:sysmt+9,224:sysmt+3,15,34,1,5,160,gc:print"";:poke646,gc
  141. 1470 fori=1to4:sysmt+15,16,i,tm$(i):next:sysmt+15,16,i,dm$(7)
  142. 1480 sysmt,1,15,34,5,gc,tc,32:sysmt+6,232:sysmt+9,216:geta$:ifval(a$)=0then1510
  143. 1490 onval(a$)goto1140,920,1120,1500,240
  144. 1500 sysmt+9,232:sysmt+3,0,39,24,24,32,0:goto1150
  145. 1510 mu=4:sysmt+9,224:sysmt+3,22,33,1,10,160,gc:print"";:poke646,gc
  146. 1520 fori=1to9:sysmt+15,23,i,"[209]uadrant"+str$(i):next:sysmt+15,23,i,dm$(7)
  147. 1530 sysmt,1,22,33,10,gc,tc,32:sysmt+6,232:sysmt+9,216:geta$:ifa$=""then1270
  148. 1535 a=asc(a$)-48
  149. 1540 onagoto1550,1560,1570,1580,1590,1600,1610,1620,1630,240
  150. 1550 co=c:gosub1640:c=co:goto200
  151. 1560 co=c2:gosub1640:c2=co:goto200
  152. 1570 co=c3:gosub1640:c3=co:goto200
  153. 1580 co=c4:gosub1640:c4=co:goto200
  154. 1590 co=c5:gosub1640:c5=co:goto200
  155. 1600 co=c6:gosub1640:c6=co:goto200
  156. 1610 co=c7:gosub1640:c7=co:goto200
  157. 1620 co=c8:gosub1640:c8=co:goto200
  158. 1630 co=c9:gosub1640:c9=co:goto200
  159. 1640 sysmt+9,232:sysmt+3,0,39,24,24,32,0
  160. 1650 sysmt+3,12,24,2,17,160,tc:poke646,tc:poke199,1
  161. 1660 fori=1to16:sysmt+15,13,i+1,c$(i):next
  162. 1670 sysmt,2,12,24,16,tc,cc,0:getc$:co=asc(c$)-49
  163. 1675 sysmt+9,216:return
  164. 1680 ms$="[208]lease [197]nter [198]ont [206]ame":poke787,255:gosub1050:sysmt+3,1,37,16,16,99,tc
  165. 1690 sysmt+3,3,36,15,15,32,gc:sysmt+15,1,15,"":sys9*4096,tc,gc,34
  166. 1700 ifw$=""thensysmt+9,216:goto240
  167. 1710 ms$="[206]ew [204]oad [193]ddress?":poke787,255:gosu